﻿{-# OPTIONS_GHC -fglasgow-exts #-}
module XI.Directory.GetXiObj where
import WS.Runtime.Main(WsParams (..))
import qualified WS.XI.CommunicationChannelServiceVi as CC 
import qualified WS.XI.SenderAgreementServiceVi as SA
import qualified WS.XI.ReceiverAgreementServiceVi as RA
import qualified WS.XI.ReceiverDeterminationServiceVi as RD
import qualified WS.XI.InterfaceDeterminationServiceVi as ID
import qualified WS.XI.ConfigurationScenarioServiceVi as CS
import qualified WS.XI.IntegrationProcessServiceVi as IP
import qualified WS.XI.Com.Sap.Aii.Ibdir.Server.Api.Types as Ibdir

import qualified WS.XI.Com.Sap.Aii.Ib.Server.Api.Types as S0

import Data.Maybe
import Data.Monoid
import Data.List
import Data.Ord
import XI.Directory.Types
import Control.Arrow
import Control.Monad
import qualified Data.Map as Map

{- | Получение данных из XI. Getting data from XI -}
getXiList :: forall t c a a1 a2 a3 b a4 a5 c1 a6 a7 c2 a8 a9 (m :: * -> *) a10. (Monad m, Ord a10) =>
        t
        -> (t -> c -> m a)
        -> (Maybe a1 -> Maybe a2 -> Maybe a3 -> b)
        -> (Maybe b -> c)
        -> (a -> Maybe a4)
        -> (a4 -> Maybe [a5])
        -> (t -> c1 -> m a6)
        -> (Maybe a7 -> Maybe [a5] -> c2)
        -> (Maybe c2 -> c1)
        -> (a6 -> Maybe a8)
        -> (a8 -> Maybe [a9])
        -> (a9 -> [a10])
        -> m [a10]
getXiList wsp wsq cq1 cq2 fq1 fq2 wsr cr1 cr2 fr1 fr2 getObj = 
    liftM (sort . concatMap getObj) (getList wsq cq1 cq2 fq1 fq2 >>= getDescList wsr cr1 cr2 fr1 fr2)
    where
        parseResult f1 f2 x = maybeToList (f1 x) >>= concat . maybeToList . f2
        getList ws c1 c2 f1 f2 = liftM (parseResult f1 f2) getQueryResult
            where
                getQueryResult = ws wsp . c2 . Just . c1 Nothing Nothing $ Nothing    
        getDescList ws c1 c2 f1 f2 xs = liftM (parseResult f1 f2) getReadResult
            where
                getReadResult = ws wsp . c2 . Just . c1 Nothing. Just $ xs    
    
getCC :: WsParams -> IO [XIObj]
getCC wsp = getXiList wsp 
        CC.query Ibdir.CommunicationChannelQueryIn__ CC.Query__ CC.responseQueryResponse Ibdir.communicationChannelIDCommunicationChannelQueryOut
        CC.read Ibdir.CommunicationChannelReadIn__ CC.Read__ CC.responseReadResponse Ibdir.communicationChannelCommunicationChannelReadOut
        getCCObj

getSA :: WsParams -> IO [XIObj]
getSA wsp = getXiList wsp 
        SA.query Ibdir.SenderAgreementQueryIn__ SA.Query__ SA.responseQueryResponse Ibdir.senderAgreementIDSenderAgreementQueryOut
        SA.read Ibdir.SenderAgreementReadIn__ SA.Read__ SA.responseReadResponse Ibdir.senderAgreementSenderAgreementReadOut
        getSAObj

getRA :: WsParams -> IO [XIObj]
getRA wsp = getXiList wsp 
        RA.query Ibdir.ReceiverAgreementQueryIn__ RA.Query__ RA.responseQueryResponse Ibdir.receiverAgreementIDReceiverAgreementQueryOut
        RA.read Ibdir.ReceiverAgreementReadIn__ RA.Read__ RA.responseReadResponse Ibdir.receiverAgreementReceiverAgreementReadOut
        getRAObj

getRD :: WsParams -> IO [XIObj]
getRD wsp = getXiList wsp 
        RD.query Ibdir.ReceiverDeterminationQueryIn__ RD.Query__ RD.responseQueryResponse Ibdir.receiverDeterminationIDReceiverDeterminationQueryOut
        RD.read Ibdir.ReceiverDeterminationReadIn__ RD.Read__ RD.responseReadResponse Ibdir.receiverDeterminationReceiverDeterminationReadOut
        getRDObj

getID :: WsParams -> IO [XIObj]
getID wsp = getXiList wsp 
        ID.query Ibdir.InterfaceDeterminationQueryIn__ ID.Query__ ID.responseQueryResponse Ibdir.interfaceDeterminationIDInterfaceDeterminationQueryOut
        ID.read Ibdir.InterfaceDeterminationReadIn__ ID.Read__ ID.responseReadResponse Ibdir.interfaceDeterminationInterfaceDeterminationReadOut
        getIDObj

getIP :: WsParams -> IO [XIObj]
getIP wsp = getXiList wsp 
        IP.query Ibdir.IntegrationProcessQueryIn__ IP.Query__ IP.responseQueryResponse Ibdir.integrationProcessIDIntegrationProcessQueryOut
        IP.read Ibdir.IntegrationProcessReadIn__ IP.Read__ IP.responseReadResponse Ibdir.integrationProcessIntegrationProcessReadOut
        getIPObj

getCS :: WsParams -> IO [XIObj]
getCS wsp = getXiList wsp 
        CS.query Ibdir.ConfigurationScenarioQueryIn__ CS.Query__ CS.responseQueryResponse Ibdir.configurationScenarioIDConfigurationScenarioQueryOut
        CS.read Ibdir.ConfigurationScenarioReadIn__ CS.Read__ CS.responseReadResponse Ibdir.configurationScenarioConfigurationScenarioReadOut
        getCSObj

getCCObj :: Ibdir.CommunicationChannel__ -> [XIObj]
getCCObj desc = maybeToList $ do
    ccid <- Ibdir.communicationChannelIDCommunicationChannel desc
    sys <- Ibdir.componentIDCommunicationChannelID ccid
    cc <- Ibdir.channelIDCommunicationChannelID ccid
    d <- Ibdir.directionCommunicationChannel desc
    amn <- Ibdir.adapterMetadataCommunicationChannel desc >>= Ibdir.nameDesignObjectID
    asacc <- Ibdir.adapterSpecificAttributeCommunicationChannel desc
    astacc <- Ibdir.adapterSpecificTableAttributeCommunicationChannel desc
    mp <- Ibdir.moduleProcessCommunicationChannel desc
    return CC {	
            cc_system = XISystem (Ibdir.partyIDCommunicationChannelID ccid) sys,
            cc_name = cc,
            cc_description = getDescription $ Ibdir.descriptionCommunicationChannel desc,
            cc_param = (ccType d, readAT amn),
            cc_param_map = Just CCParams {
                    ccParams = mkMap $ map (Ibdir.nameGenericProperty &&& Ibdir.valueGenericProperty) asacc ,
                    ccTabParams = mkMap (
                        map (\tab -> (Ibdir.nameGenericPropertyTable tab,
                                Just CCTabParam {
                                        tpRows = map (
                                                mkMap . 
                                                map (Ibdir.columnNameGenericTableRowTableCell &&& Ibdir.valueGenericTableRowTableCell) .
                                                fromMaybe' . Ibdir.valueTableCellGenericTableRow
                                            ) $ fromMaybe' $ Ibdir.valueTableRowGenericPropertyTable tab
                                    }
                            )
                        ) astacc),
                    ccModules = [CCModules {
                                        ccmName = fromMaybe' $ Ibdir.moduleNameProcessStep m,
                                        ccmType = fromMaybe' $ Ibdir.moduleTypeProcessStep m,
                                        ccmParams = mkMap [(Ibdir.nameGenericPropertyRestricted &&& Ibdir.valueGenericPropertyRestricted) par | 
                                                    pg <- fromMaybe' $ Ibdir.parameterGroupModuleProcess mp, 
                                                    Ibdir.parameterGroupIDProcessStep m == Ibdir.parameterGroupIDParameterGroup pg,
                                                    par <- fromMaybe' $ Ibdir.parameterParameterGroup pg]
                                    } | m <- fromMaybe' $ Ibdir.processStepModuleProcess mp]
                }
        }
    where
        fromJustMap xs = [(a, b) | (Just a, Just b) <- xs]
        mkMap = Map.fromList . fromJustMap
        fromMaybe' x = fromMaybe mempty x

getSAObj :: Ibdir.SenderAgreement__ -> [XIObj]
getSAObj desc = maybeToList $ do
    said <- Ibdir.senderAgreementIDSenderAgreement desc
    sys <- Ibdir.senderComponentIDMessageHeaderID said
    inm <- Ibdir.interfaceNameMessageHeaderID said
    ins <- Ibdir.interfaceNamespaceMessageHeaderID said
    ccid <- Ibdir.communicationChannelSenderAgreement desc
    cc <- Ibdir.channelIDCommunicationChannelID ccid
    return SAgg {	
            sender = XISystem (Ibdir.senderPartyIDMessageHeaderID said) sys,
            sender_int = (ins ++ "/" ++ inm),
            sa_description = getDescription $ Ibdir.descriptionSenderAgreement desc,
            sender_cc = cc 
        }

getRAObj :: Ibdir.ReceiverAgreement__ -> [XIObj]
getRAObj desc = maybeToList $ do
    raid <- Ibdir.receiverAgreementIDReceiverAgreement desc
    ssys <- Ibdir.senderComponentIDMessageHeaderID raid
    sys <- Ibdir.receiverComponentIDMessageHeaderID raid
    inm <- Ibdir.interfaceNameMessageHeaderID raid
    ins <- Ibdir.interfaceNamespaceMessageHeaderID raid
    cc <- Ibdir.communicationChannelReceiverAgreement desc >>= Ibdir.channelIDCommunicationChannelID
    return RAgg {	
            sender = XISystem (Ibdir.senderPartyIDMessageHeaderID raid) ssys,
            receiver = XISystem (Ibdir.receiverPartyIDMessageHeaderID raid) sys,
            receiver_int = (ins ++ "/" ++ inm),
            ra_description = getDescription $ Ibdir.descriptionReceiverAgreement desc,
            receiver_cc = cc 
        }

getDescription :: Maybe [S0.LONG_Description__] -> String
getDescription Nothing = ""
getDescription (Just descs) = fromMaybe "" . fromMaybe Nothing . fmap S0.valueLONG_Description . listToMaybe . sortBy (comparing f) $ descs
    where
        f = fromMaybe 3 . flip lookup (zip ["RU", "EN", "DE"] [(0::Int)..]) . fromMaybe "" . S0.languageCodeLONG_Description

getRDObj :: Ibdir.ReceiverDetermination__ -> [XIObj]
getRDObj desc = do	
    rdid <- maybeToList $ Ibdir.receiverDeterminationIDReceiverDetermination desc
    ssys <- maybeToList $ Ibdir.senderComponentIDMessageHeaderID rdid
    inm <- maybeToList $ Ibdir.interfaceNameMessageHeaderID rdid
    ins <- maybeToList $ Ibdir.interfaceNamespaceMessageHeaderID rdid
    rdr <- maybeToList $ Ibdir.ruleReceiverDetermination desc
    return RD {
            sender = XISystem (Ibdir.senderPartyIDMessageHeaderID rdid) ssys,
            sender_int = ins ++ "/" ++ inm,
            rd_description = getDescription $ Ibdir.descriptionReceiverDetermination desc,
            cond_receivers = sort $ 
                    rdr >>= concat . maybeToList . Ibdir.receiverReceiverDeterminationRule >>=
                            \rule -> let val f = f rule >>= Ibdir.valueExtractor in
                                liftM 
                                    ((,) Nothing . XISystem (val Ibdir.communicationPartyCommunicationPartnerExtractor))
                                    (maybeToList (val Ibdir.communicationComponentCommunicationPartnerExtractor))
        }
(+/+) :: String -> String -> String
(+/+) a = (a ++) . ("/" ++)

getIDObj :: Ibdir.InterfaceDetermination__ -> [XIObj]
getIDObj desc = do
    idid <- maybeToList $ Ibdir.interfaceDeterminationIDInterfaceDetermination desc
    ssys <- maybeToList $ Ibdir.senderComponentIDMessageHeaderID idid
    sint <- maybeToList $ liftM2 (+/+) (Ibdir.interfaceNamespaceMessageHeaderID idid) (Ibdir.interfaceNameMessageHeaderID idid)
    rsys <- maybeToList $ Ibdir.receiverComponentIDMessageHeaderID idid
    rule <- maybeToList $ Ibdir.ruleInterfaceDetermination desc
    return ID {
            sender = XISystem (Ibdir.senderPartyIDMessageHeaderID idid) ssys,
            sender_int = sint,
            receiver = XISystem (Ibdir.receiverPartyIDMessageHeaderID idid) rsys,
            id_description = getDescription $ Ibdir.descriptionInterfaceDetermination desc,
            cond_receiver_ints = sort $ do
                rule' <- rule
                inmns <- (concat . maybeToList . Ibdir.interfaceInterfaceDeterminationRule) rule' >>= maybeToList . get_nmns
                return (Nothing, inmns, Ibdir.mappingInterfaceDeterminationRule rule' >>= get_nmns)
        }
    where
        get_nmns x = liftM2 (+/+) (Ibdir.namespaceDesignObjectID x) (Ibdir.nameDesignObjectID x)

getIPObj :: Ibdir.IntegrationProcess__ -> [XIObj]
getIPObj desc = do
    ipid <- maybeToList $ Ibdir.integrationProcessIDIntegrationProcess desc
    ip <- maybeToList $ Ibdir.componentIDCommunicationComponentID ipid
    return IP {
            ip_system = XISystem (Ibdir.partyIDCommunicationComponentID ipid) ip,
            ip_description = getDescription $ Ibdir.descriptionIntegrationProcess desc
        }

getCSObj :: Ibdir.ConfigurationScenario__ -> [XIObj]
getCSObj desc = do
    csid <- maybeToList $ Ibdir.configurationScenarioIDConfigurationScenario desc
    return Sc {
            sc_name = csid,
            sc_description = getDescription $ Ibdir.descriptionConfigurationScenario desc,
            sc_ids = sort ( 
                    do
                        cc 		<- concat $ maybeToList $ Ibdir.communicationChannelConfigurationScenario desc
                        sys		<- maybeToList $ Ibdir.componentIDCommunicationChannelID cc
                        ccid	<- maybeToList $ Ibdir.channelIDCommunicationChannelID cc
                        return ("CC|" ++ sys ++ "|" ++ ccid)
                    ++ 
                    do
                        sa 	<- concat $ maybeToList $ Ibdir.senderAgreementConfigurationScenario desc
                        sys	<- maybeToList $ Ibdir.senderComponentIDMessageHeaderID sa
                        ns 	<- maybeToList $ Ibdir.interfaceNamespaceMessageHeaderID sa
                        nm 	<- maybeToList $ Ibdir.interfaceNameMessageHeaderID sa
                        return $ "SAGG|" ++ sys ++ "|" ++ ns ++ "/" ++ nm
                    ++ 
                    do
                        ra 	<- concat $ maybeToList $ Ibdir.receiverAgreementConfigurationScenario desc
                        ssys<- maybeToList $ Ibdir.senderComponentIDMessageHeaderID ra
                        sys	<- maybeToList $ Ibdir.receiverComponentIDMessageHeaderID ra
                        ns 	<- maybeToList $ Ibdir.interfaceNamespaceMessageHeaderID ra
                        nm 	<- maybeToList $ Ibdir.interfaceNameMessageHeaderID ra
                        return $ "RAGG|" ++ ssys ++ "|" ++ sys ++ "|" ++ ns ++ "/" ++ nm
                    ++ 
                    do
                        rd 	<- concat $ maybeToList $ Ibdir.receiverDeterminationConfigurationScenario desc
                        sys	<- maybeToList $ Ibdir.senderComponentIDMessageHeaderID rd
                        ns 	<- maybeToList $ Ibdir.interfaceNamespaceMessageHeaderID rd
                        nm 	<- maybeToList $ Ibdir.interfaceNameMessageHeaderID rd
                        return $ "RD|" ++ sys ++ "|" ++ ns ++ "/" ++ nm
                    ++ 
                    do
                        idt 	<- concat $ maybeToList $ Ibdir.interfaceDeterminationConfigurationScenario desc
                        ssys	<- maybeToList $ Ibdir.senderComponentIDMessageHeaderID idt
                        rsys	<- maybeToList $ Ibdir.receiverComponentIDMessageHeaderID idt
                        ns 	    <- maybeToList $ Ibdir.interfaceNamespaceMessageHeaderID idt
                        nm 	    <- maybeToList $ Ibdir.interfaceNameMessageHeaderID idt
                        return $ "ID|" ++ ssys ++ "|" ++ ns ++ "/" ++ nm ++ "|" ++ rsys
                )
        }